home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / XLISP.LZH / XLISPSRC.ARC / XLLIST.C < prev    next >
Text File  |  1986-05-17  |  19KB  |  835 lines
  1. /* xllist.c - xlisp built-in list functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. #ifdef MEGAMAX
  9. overlay "overflow"
  10. #endif
  11.  
  12. /* external variables */
  13. extern NODE *s_unbound;
  14. extern NODE *true;
  15.  
  16. /* forward declarations */
  17. FORWARD NODE *cxr();
  18. FORWARD NODE *nth(),*assoc();
  19. FORWARD NODE *subst(),*sublis(),*map();
  20.  
  21. /* xcar - take the car of a cons cell */
  22. NODE *xcar(args)
  23.   NODE *args;
  24. {
  25.     NODE *list;
  26.     list = xlmatch(LIST,&args);
  27.     xllastarg(args);
  28.     return (list ? car(list) : NIL);
  29. }
  30.  
  31. /* xcdr - take the cdr of a cons cell */
  32. NODE *xcdr(args)
  33.   NODE *args;
  34. {
  35.     NODE *list;
  36.     list = xlmatch(LIST,&args);
  37.     xllastarg(args);
  38.     return (list ? cdr(list) : NIL);
  39. }
  40.  
  41. /* cxxr functions */
  42. NODE *xcaar(args) NODE *args; { return (cxr(args,"aa")); }
  43. NODE *xcadr(args) NODE *args; { return (cxr(args,"da")); }
  44. NODE *xcdar(args) NODE *args; { return (cxr(args,"ad")); }
  45. NODE *xcddr(args) NODE *args; { return (cxr(args,"dd")); }
  46.  
  47. /* cxxxr functions */
  48. NODE *xcaaar(args) NODE *args; { return (cxr(args,"aaa")); }
  49. NODE *xcaadr(args) NODE *args; { return (cxr(args,"daa")); }
  50. NODE *xcadar(args) NODE *args; { return (cxr(args,"ada")); }
  51. NODE *xcaddr(args) NODE *args; { return (cxr(args,"dda")); }
  52. NODE *xcdaar(args) NODE *args; { return (cxr(args,"aad")); }
  53. NODE *xcdadr(args) NODE *args; { return (cxr(args,"dad")); }
  54. NODE *xcddar(args) NODE *args; { return (cxr(args,"add")); }
  55. NODE *xcdddr(args) NODE *args; { return (cxr(args,"ddd")); }
  56.  
  57. /* cxxxxr functions */
  58. NODE *xcaaaar(args) NODE *args; { return (cxr(args,"aaaa")); }
  59. NODE *xcaaadr(args) NODE *args; { return (cxr(args,"daaa")); }
  60. NODE *xcaadar(args) NODE *args; { return (cxr(args,"adaa")); }
  61. NODE *xcaaddr(args) NODE *args; { return (cxr(args,"ddaa")); }
  62. NODE *xcadaar(args) NODE *args; { return (cxr(args,"aada")); }
  63. NODE *xcadadr(args) NODE *args; { return (cxr(args,"dada")); }
  64. NODE *xcaddar(args) NODE *args; { return (cxr(args,"adda")); }
  65. NODE *xcadddr(args) NODE *args; { return (cxr(args,"ddda")); }
  66. NODE *xcdaaar(args) NODE *args; { return (cxr(args,"aaad")); }
  67. NODE *xcdaadr(args) NODE *args; { return (cxr(args,"daad")); }
  68. NODE *xcdadar(args) NODE *args; { return (cxr(args,"adad")); }
  69. NODE *xcdaddr(args) NODE *args; { return (cxr(args,"ddad")); }
  70. NODE *xcddaar(args) NODE *args; { return (cxr(args,"aadd")); }
  71. NODE *xcddadr(args) NODE *args; { return (cxr(args,"dadd")); }
  72. NODE *xcdddar(args) NODE *args; { return (cxr(args,"addd")); }
  73. NODE *xcddddr(args) NODE *args; { return (cxr(args,"dddd")); }
  74.  
  75. /* cxr - common car/cdr routine */
  76. LOCAL NODE *cxr(args,adstr)
  77.   NODE *args; char *adstr;
  78. {
  79.     NODE *list;
  80.  
  81.     /* get the list */
  82.     list = xlmatch(LIST,&args);
  83.     xllastarg(args);
  84.  
  85.     /* perform the car/cdr operations */
  86.     while (*adstr && consp(list))
  87.     list = (*adstr++ == 'a' ? car(list) : cdr(list));
  88.  
  89.     /* make sure the operation succeeded */
  90.     if (*adstr && list)
  91.     xlfail("bad argument");
  92.  
  93.     /* return the result */
  94.     return (list);
  95. }
  96.  
  97. /* xcons - construct a new list cell */
  98. NODE *xcons(args)
  99.   NODE *args;
  100. {
  101.     NODE *arg1,*arg2;
  102.  
  103.     /* get the two arguments */
  104.     arg1 = xlarg(&args);
  105.     arg2 = xlarg(&args);
  106.     xllastarg(args);
  107.  
  108.     /* construct a new list element */
  109.     return (cons(arg1,arg2));
  110. }
  111.  
  112. /* xlist - built a list of the arguments */
  113. NODE *xlist(args)
  114.   NODE *args;
  115. {
  116.     NODE ***oldstk,*last,*next,*val;
  117.  
  118.     /* create a new stack frame */
  119.     oldstk = xlstack;
  120.     xlsave1(val);
  121.  
  122.     /* add each argument to the list */
  123.     for (val = NIL; consp(args); args = cdr(args)) {
  124.  
  125.     /* append this argument to the end of the list */
  126.     next = consa(car(args));
  127.     if (val) rplacd(last,next);
  128.     else val = next;
  129.     last = next;
  130.     }
  131.  
  132.     /* restore the previous stack frame */
  133.     xlstack = oldstk;
  134.  
  135.     /* return the list */
  136.     return (val);
  137. }
  138.  
  139. /* xappend - built-in function append */
  140. NODE *xappend(args)
  141.   NODE *args;
  142. {
  143.     NODE ***oldstk,*list,*last,*next,*val;
  144.  
  145.     /* create a new stack frame */
  146.     oldstk = xlstack;
  147.     xlsave1(val);
  148.  
  149.     /* append each argument */
  150.     for (val = NIL; consp(args); args = cdr(args)) {
  151.  
  152.     /* append each element of this list to the result list */
  153.     for (list = car(args); consp(list); list = cdr(list)) {
  154.  
  155.         /* append this element */
  156.         next = consa(car(list));
  157.         if (val) rplacd(last,next);
  158.         else val = next;
  159.         last = next;
  160.     }
  161.     }
  162.  
  163.     /* restore previous stack frame */
  164.     xlstack = oldstk;
  165.  
  166.     /* return the list */
  167.     return (val);
  168. }
  169.  
  170. /* xreverse - built-in function reverse */
  171. NODE *xreverse(args)
  172.   NODE *args;
  173. {
  174.     NODE ***oldstk,*list,*val;
  175.  
  176.     /* create a new stack frame */
  177.     oldstk = xlstack;
  178.     xlsave1(val);
  179.  
  180.     /* get the list to reverse */
  181.     list = xlmatch(LIST,&args);
  182.     xllastarg(args);
  183.  
  184.     /* append each element to the head of the result list */
  185.     for (val = NIL; consp(list); list = cdr(list))
  186.     val = cons(car(list),val);
  187.  
  188.     /* restore previous stack frame */
  189.     xlstack = oldstk;
  190.  
  191.     /* return the list */
  192.     return (val);
  193. }
  194.  
  195. /* xlast - return the last cons of a list */
  196. NODE *xlast(args)
  197.   NODE *args;
  198. {
  199.     NODE *list;
  200.  
  201.     /* get the list */
  202.     list = xlmatch(LIST,&args);
  203.     xllastarg(args);
  204.  
  205.     /* find the last cons */
  206.     while (consp(list) && cdr(list))
  207.     list = cdr(list);
  208.  
  209.     /* return the last element */
  210.     return (list);
  211. }
  212.  
  213. /* xmember - built-in function 'member' */
  214. NODE *xmember(args)
  215.   NODE *args;
  216. {
  217.     NODE ***oldstk,*x,*list,*fcn,*val;
  218.     int tresult;
  219.  
  220.     /* create a new stack frame */
  221.     oldstk = xlstack;
  222.     xlsave1(fcn);
  223.  
  224.     /* get the expression to look for and the list */
  225.     x = xlarg(&args);
  226.     list = xlmatch(LIST,&args);
  227.     xltest(&fcn,&tresult,&args);
  228.     xllastarg(args);
  229.  
  230.     /* look for the expression */
  231.     for (val = NIL; consp(list); list = cdr(list))
  232.     if (dotest(x,car(list),fcn) == tresult) {
  233.         val = list;
  234.         break;
  235.     }
  236.  
  237.     /* restore the previous stack frame */
  238.     xlstack = oldstk;
  239.  
  240.     /* return the result */
  241.     return (val);
  242. }
  243.  
  244. /* xassoc - built-in function 'assoc' */
  245. NODE *xassoc(args)
  246.   NODE *args;
  247. {
  248.     NODE ***oldstk,*x,*alist,*fcn,*pair,*val;
  249.     int tresult;
  250.  
  251.     /* create a new stack frame */
  252.     oldstk = xlstack;
  253.     xlsave1(fcn);
  254.  
  255.     /* get the expression to look for and the association list */
  256.     x = xlarg(&args);
  257.     alist = xlmatch(LIST,&args);
  258.     xltest(&fcn,&tresult,&args);
  259.     xllastarg(args);
  260.  
  261.     /* look for the expression */
  262.     for (val = NIL; consp(alist); alist = cdr(alist))
  263.     if ((pair = car(alist)) && consp(pair))
  264.         if (dotest(x,car(pair),fcn) == tresult) {
  265.         val = pair;
  266.         break;
  267.         }
  268.  
  269.     /* restore the previous stack frame */
  270.     xlstack = oldstk;
  271.  
  272.     /* return result */
  273.     return (val);
  274. }
  275.  
  276. /* xsubst - substitute one expression for another */
  277. NODE *xsubst(args)
  278.   NODE *args;
  279. {
  280.     NODE ***oldstk,*to,*from,*expr,*fcn,*val;
  281.     int tresult;
  282.  
  283.     /* create a new stack frame */
  284.     oldstk = xlstack;
  285.     xlsave1(fcn);
  286.  
  287.     /* get the to value, the from value and the expression */
  288.     to = xlarg(&args);
  289.     from = xlarg(&args);
  290.     expr = xlarg(&args);
  291.     xltest(&fcn,&tresult,&args);
  292.     xllastarg(args);
  293.  
  294.     /* do the substitution */
  295.     val = subst(to,from,expr,fcn,tresult);
  296.  
  297.     /* restore the previous stack frame */
  298.     xlstack = oldstk;
  299.  
  300.     /* return the result */
  301.     return (val);
  302. }
  303.  
  304. /* subst - substitute one expression for another */
  305. LOCAL NODE *subst(to,from,expr,fcn,tresult)
  306.   NODE *to,*from,*expr,*fcn; int tresult;
  307. {
  308.     NODE ***oldstk,*carval,*cdrval;
  309.  
  310.     if (dotest(expr,from,fcn) == tresult)
  311.     return (to);
  312.     else if (consp(expr)) {
  313.     oldstk = xlstack;
  314.     xlsave1(carval);
  315.     carval = subst(to,from,car(expr),fcn,tresult);
  316.     cdrval = subst(to,from,cdr(expr),fcn,tresult);
  317.     xlstack = oldstk;
  318.     return (cons(carval,cdrval));
  319.     }
  320.     else
  321.     return (expr);
  322. }
  323.  
  324. /* xsublis - substitute using an association list */
  325. NODE *xsublis(args)
  326.   NODE *args;
  327. {
  328.     NODE ***oldstk,*alist,*expr,*fcn,*val;
  329.     int tresult;
  330.  
  331.     /* create a new stack frame */
  332.     oldstk = xlstack;
  333.     xlsave1(fcn);
  334.  
  335.     /* get the assocation list and the expression */
  336.     alist = xlmatch(LIST,&args);
  337.     expr = xlarg(&args);
  338.     xltest(&fcn,&tresult,&args);
  339.     xllastarg(args);
  340.  
  341.     /* do the substitution */
  342.     val = sublis(alist,expr,fcn,tresult);
  343.  
  344.     /* restore the previous stack frame */
  345.     xlstack = oldstk;
  346.  
  347.     /* return the result */
  348.     return (val);
  349. }
  350.  
  351. /* sublis - substitute using an association list */
  352. LOCAL NODE *sublis(alist,expr,fcn,tresult)
  353.   NODE *alist,*expr,*fcn; int tresult;
  354. {
  355.     NODE ***oldstk,*carval,*cdrval,*pair;
  356.  
  357.     if (pair = assoc(expr,alist,fcn,tresult))
  358.     return (cdr(pair));
  359.     else if (consp(expr)) {
  360.     oldstk = xlstack;
  361.     xlsave1(carval);
  362.     carval = sublis(alist,car(expr),fcn,tresult);
  363.     cdrval = sublis(alist,cdr(expr),fcn,tresult);
  364.     xlstack = oldstk;
  365.     return (cons(carval,cdrval));
  366.     }
  367.     else
  368.     return (expr);
  369. }
  370.  
  371. /* assoc - find a pair in an association list */
  372. LOCAL NODE *assoc(expr,alist,fcn,tresult)
  373.   NODE *expr,*alist,*fcn; int tresult;
  374. {
  375.     NODE *pair;
  376.  
  377.     for (; consp(alist); alist = cdr(alist))
  378.     if ((pair = car(alist)) && consp(pair))
  379.         if (dotest(expr,car(pair),fcn) == tresult)
  380.         return (pair);
  381.     return (NIL);
  382. }
  383.  
  384. /* xremove - built-in function 'remove' */
  385. NODE *xremove(args)
  386.   NODE *args;
  387. {
  388.     NODE ***oldstk,*x,*list,*fcn,*val,*last,*next;
  389.     int tresult;
  390.  
  391.     /* create a new stack frame */
  392.     oldstk = xlstack;
  393.     xlstkcheck(2);
  394.     xlsave(fcn);
  395.     xlsave(val);
  396.  
  397.     /* get the expression to remove and the list */
  398.     x = xlarg(&args);
  399.     list = xlmatch(LIST,&args);
  400.     xltest(&fcn,&tresult,&args);
  401.     xllastarg(args);
  402.  
  403.     /* remove matches */
  404.     for (; consp(list); list = cdr(list))
  405.  
  406.     /* check to see if this element should be deleted */
  407.     if (dotest(x,car(list),fcn) != tresult) {
  408.         next = consa(car(list));
  409.         if (val) rplacd(last,next);
  410.         else val = next;
  411.         last = next;
  412.     }
  413.  
  414.     /* restore the previous stack frame */
  415.     xlstack = oldstk;
  416.  
  417.     /* return the updated list */
  418.     return (val);
  419. }
  420.  
  421. /* dotest - call a test function */
  422. int dotest(arg1,arg2,fcn)
  423.   NODE *arg1,*arg2,*fcn;
  424. {
  425.     NODE ***oldstk,*args,*val;
  426.  
  427.     /* create a new stack frame */
  428.     oldstk = xlstack;
  429.     xlsave1(args);
  430.  
  431.     /* build an argument list */
  432.     args = cons(arg1,consa(arg2));
  433.  
  434.     /* apply the test function */
  435.     val = xlapply(fcn,args);
  436.  
  437.     /* restore the previous stack frame */
  438.     xlstack = oldstk;
  439.  
  440.     /* return the result of the test */
  441.     return (val != NIL);
  442. }
  443.  
  444. /* xnth - return the nth element of a list */
  445. NODE *xnth(args)
  446.   NODE *args;
  447. {
  448.     return (nth(args,TRUE));
  449. }
  450.  
  451. /* xnthcdr - return the nth cdr of a list */
  452. NODE *xnthcdr(args)
  453.   NODE *args;
  454. {
  455.     return (nth(args,FALSE));
  456. }
  457.  
  458. /* nth - internal nth function */
  459. LOCAL NODE *nth(args,carflag)
  460.   NODE *args; int carflag;
  461. {
  462.     NODE *list;
  463.     FIXNUM n;
  464.  
  465.     /* get n and the list */
  466.     if ((n = getfixnum(xlmatch(INT,&args))) < 0)
  467.     xlfail("bad argument");
  468.     if ((list = xlmatch(LIST,&args)) == NIL)
  469.     xlfail("bad argument");
  470.     xllastarg(args);
  471.  
  472.     /* find the nth element */
  473.     while (consp(list) && --n >= 0)
  474.     list = cdr(list);
  475.  
  476.     /* return the list beginning at the nth element */
  477.     return (carflag && consp(list) ? car(list) : list);
  478. }
  479.  
  480. /* xlength - return the length of a list or string */
  481. NODE *xlength(args)
  482.   NODE *args;
  483. {
  484.     NODE *arg;
  485.     FIXNUM n;
  486.  
  487.     /* get the list or string */
  488.     arg = xlarg(&args);
  489.     xllastarg(args);
  490.  
  491.     /* find the length of a list */
  492.     if (listp(arg))
  493.     for (n = 0; consp(arg); n++)
  494.         arg = cdr(arg);
  495.  
  496.     /* find the length of a string */
  497.     else if (stringp(arg))
  498.     n = strlen(getstring(arg));
  499.  
  500.     /* find the length of a vector */
  501.     else if (vectorp(arg))
  502.     n = getsize(arg);
  503.  
  504.     /* otherwise, bad argument type */
  505.     else
  506.     xlerror("bad argument type",arg);
  507.  
  508.     /* return the length */
  509.     return (cvfixnum(n));
  510. }
  511.  
  512. /* xmapc - built-in function 'mapc' */
  513. NODE *xmapc(args)
  514.   NODE *args;
  515. {
  516.     return (map(args,TRUE,FALSE));
  517. }
  518.  
  519. /* xmapcar - built-in function 'mapcar' */
  520. NODE *xmapcar(args)
  521.   NODE *args;
  522. {
  523.     return (map(args,TRUE,TRUE));
  524. }
  525.  
  526. /* xmapl - built-in function 'mapl' */
  527. NODE *xmapl(args)
  528.   NODE *args;
  529. {
  530.     return (map(args,FALSE,FALSE));
  531. }
  532.  
  533. /* xmaplist - built-in function 'maplist' */
  534. NODE *xmaplist(args)
  535.   NODE *args;
  536. {
  537.     return (map(args,FALSE,TRUE));
  538. }
  539.  
  540. /* map - internal mapping function */
  541. LOCAL NODE *map(args,carflag,valflag)
  542.   NODE *args; int carflag,valflag;
  543. {
  544.     NODE ***oldstk,*fcn,*lists,*arglist,*val,*last,*p,*x,*y;
  545.  
  546.     /* create a new stack frame */
  547.     oldstk = xlstack;
  548.     xlstkcheck(4);
  549.     xlsave(fcn);
  550.     xlsave(lists);
  551.     xlsave(arglist);
  552.     xlsave(val);
  553.  
  554.     /* get the function to apply and the first list */
  555.     fcn = xlarg(&args);
  556.     lists = xlmatch(LIST,&args);
  557.  
  558.     /* save the first list if not saving function values */
  559.     if (!valflag)
  560.     val = lists;
  561.  
  562.     /* build a list of argument lists (reversed) */
  563.     for (lists = consa(lists); args; )
  564.     lists = cons(xlmatch(LIST,&args),lists);
  565.  
  566.     /* if the function is a symbol, get its value */
  567.     if (symbolp(fcn))
  568.     fcn = xleval(fcn);
  569.  
  570.     /* loop through each of the argument lists */
  571.     for (;;) {
  572.  
  573.     /* build an argument list from the sublists */
  574.     arglist = NIL;
  575.     for (x = lists; x && (y = car(x)) && consp(y); x = cdr(x)) {
  576.         arglist = cons(carflag ? car(y) : y,arglist);
  577.         rplaca(x,cdr(y));
  578.     }
  579.  
  580.     /* quit if any of the lists were empty */
  581.     if (x) break;
  582.  
  583.     /* apply the function to the arguments */
  584.     if (valflag) {
  585.         p = consa(xlapply(fcn,arglist));
  586.         if (val) rplacd(last,p);
  587.         else val = p;
  588.         last = p;
  589.     }
  590.     else
  591.         xlapply(fcn,arglist);
  592.     }
  593.  
  594.     /* restore the previous stack frame */
  595.     xlstack = oldstk;
  596.  
  597.     /* return the last test expression value */
  598.     return (val);
  599. }
  600.  
  601. /* xrplca - replace the car of a list node */
  602. NODE *xrplca(args)
  603.   NODE *args;
  604. {
  605.     NODE *list,*newcar;
  606.  
  607.     /* get the list and the new car */
  608.     if ((list = xlmatch(LIST,&args)) == NIL)
  609.     xlfail("bad argument");
  610.     newcar = xlarg(&args);
  611.     xllastarg(args);
  612.  
  613.     /* replace the car */
  614.     rplaca(list,newcar);
  615.  
  616.     /* return the list node that was modified */
  617.     return (list);
  618. }
  619.  
  620. /* xrplcd - replace the cdr of a list node */
  621. NODE *xrplcd(args)
  622.   NODE *args;
  623. {
  624.     NODE *list,*newcdr;
  625.  
  626.     /* get the list and the new cdr */
  627.     if ((list = xlmatch(LIST,&args)) == NIL)
  628.     xlfail("bad argument");
  629.     newcdr = xlarg(&args);
  630.     xllastarg(args);
  631.  
  632.     /* replace the cdr */
  633.     rplacd(list,newcdr);
  634.  
  635.     /* return the list node that was modified */
  636.     return (list);
  637. }
  638.  
  639. /* xnconc - destructively append lists */
  640. NODE *xnconc(args)
  641.   NODE *args;
  642. {
  643.     NODE *list,*last,*val;
  644.  
  645.     /* concatenate each argument */
  646.     for (val = NIL; args; ) {
  647.  
  648.     /* concatenate this list */
  649.     if (list = xlmatch(LIST,&args)) {
  650.  
  651.         /* check for this being the first non-empty list */
  652.         if (val) rplacd(last,list);
  653.         else val = list;
  654.  
  655.         /* find the end of the list */
  656.         while (consp(cdr(list)))
  657.         list = cdr(list);
  658.  
  659.         /* save the new last element */
  660.         last = list;
  661.     }
  662.     }
  663.  
  664.     /* return the list */
  665.     return (val);
  666. }
  667.  
  668. /* xdelete - built-in function 'delete' */
  669. NODE *xdelete(args)
  670.   NODE *args;
  671. {
  672.     NODE ***oldstk,*x,*list,*fcn,*last,*val;
  673.     int tresult;
  674.  
  675.     /* create a new stack frame */
  676.     oldstk = xlstack;
  677.     xlsave1(fcn);
  678.  
  679.     /* get the expression to delete and the list */
  680.     x = xlarg(&args);
  681.     list = xlmatch(LIST,&args);
  682.     xltest(&fcn,&tresult,&args);
  683.     xllastarg(args);
  684.  
  685.     /* delete leading matches */
  686.     while (consp(list)) {
  687.     if (dotest(x,car(list),fcn) != tresult)
  688.         break;
  689.     list = cdr(list);
  690.     }
  691.     val = last = list;
  692.  
  693.     /* delete embedded matches */
  694.     if (consp(list)) {
  695.  
  696.     /* skip the first non-matching element */
  697.     list = cdr(list);
  698.  
  699.     /* look for embedded matches */
  700.     while (consp(list)) {
  701.  
  702.         /* check to see if this element should be deleted */
  703.         if (dotest(x,car(list),fcn) == tresult)
  704.         rplacd(last,cdr(list));
  705.         else
  706.         last = list;
  707.  
  708.         /* move to the next element */
  709.         list = cdr(list);
  710.      }
  711.     }
  712.  
  713.     /* restore the previous stack frame */
  714.     xlstack = oldstk;
  715.  
  716.     /* return the updated list */
  717.     return (val);
  718. }
  719.  
  720. /* xatom - is this an atom? */
  721. NODE *xatom(args)
  722.   NODE *args;
  723. {
  724.     NODE *arg;
  725.     arg = xlarg(&args);
  726.     xllastarg(args);
  727.     return (atom(arg) ? true : NIL);
  728. }
  729.  
  730. /* xsymbolp - is this an symbol? */
  731. NODE *xsymbolp(args)
  732.   NODE *args;
  733. {
  734.     NODE *arg;
  735.     arg = xlarg(&args);
  736.     xllastarg(args);
  737.     return (arg == NIL || symbolp(arg) ? true : NIL);
  738. }
  739.  
  740. /* xnumberp - is this a number? */
  741. NODE *xnumberp(args)
  742.   NODE *args;
  743. {
  744.     NODE *arg;
  745.     arg = xlarg(&args);
  746.     xllastarg(args);
  747.     return (fixp(arg) || floatp(arg) ? true : NIL);
  748. }
  749.  
  750. /* xboundp - is this a value bound to this symbol? */
  751. NODE *xboundp(args)
  752.   NODE *args;
  753. {
  754.     NODE *sym;
  755.     sym = xlmatch(SYM,&args);
  756.     xllastarg(args);
  757.     return (getvalue(sym) == s_unbound ? NIL : true);
  758. }
  759.  
  760. /* xnull - is this null? */
  761. NODE *xnull(args)
  762.   NODE *args;
  763. {
  764.     NODE *arg;
  765.     arg = xlarg(&args);
  766.     xllastarg(args);
  767.     return (null(arg) ? true : NIL);
  768. }
  769.  
  770. /* xlistp - is this a list? */
  771. NODE *xlistp(args)
  772.   NODE *args;
  773. {
  774.     NODE *arg;
  775.     arg = xlarg(&args);
  776.     xllastarg(args);
  777.     return (listp(arg) ? true : NIL);
  778. }
  779.  
  780. /* xconsp - is this a cons? */
  781. NODE *xconsp(args)
  782.   NODE *args;
  783. {
  784.     NODE *arg;
  785.     arg = xlarg(&args);
  786.     xllastarg(args);
  787.     return (consp(arg) ? true : NIL);
  788. }
  789.  
  790. /* xeq - are these equal? */
  791. NODE *xeq(args)
  792.   NODE *args;
  793. {
  794.     NODE *arg1,*arg2;
  795.  
  796.     /* get the two arguments */
  797.     arg1 = xlarg(&args);
  798.     arg2 = xlarg(&args);
  799.     xllastarg(args);
  800.  
  801.     /* compare the arguments */
  802.     return (arg1 == arg2 ? true : NIL);
  803. }
  804.  
  805. /* xeql - are these equal? */
  806. NODE *xeql(args)
  807.   NODE *args;
  808. {
  809.     NODE *arg1,*arg2;
  810.  
  811.     /* get the two arguments */
  812.     arg1 = xlarg(&args);
  813.     arg2 = xlarg(&args);
  814.     xllastarg(args);
  815.  
  816.     /* compare the arguments */
  817.     return (eql(arg1,arg2) ? true : NIL);
  818. }
  819.  
  820. /* xequal - are these equal? */
  821. NODE *xequal(args)
  822.   NODE *args;
  823. {
  824.     NODE *arg1,*arg2;
  825.  
  826.     /* get the two arguments */
  827.     arg1 = xlarg(&args);
  828.     arg2 = xlarg(&args);
  829.     xllastarg(args);
  830.  
  831.     /* compare the arguments */
  832.     return (equal(arg1,arg2) ? true : NIL);
  833. }
  834.  
  835.